home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / mapmem.arc / MAPMEM.PAS < prev   
Pascal/Delphi Source File  |  1986-01-24  |  8KB  |  264 lines
  1. {************************************************************************
  2. * maps system memory blocks for MS/PCDOS 2.0 and higher.                *
  3. * may work on other versions of DOS but hasn't been tested.             *
  4. * copyright (c) 1986 K. Kokkonen, TurboPower Software.                  *
  5. * released to the public domain for personal, non-commercial use only.  *
  6. * written 1/2/86                                                        *
  7. * revised 1/10/86 for                                                   *
  8. *   running under DOS 2.X, where block owner names are unknown          *
  9. * revised 1/22/86 for                                                   *
  10. *   a bug in parsing the owner name of the block                        *
  11. *   a quirk in the way that the DOS PRINT buffer installs itself        *
  12. *   minor cosmetic changes                                              *
  13. * telephone: 408-378-3672, CompuServe: 72457,2131.                      *
  14. * requires Turbo version 3 to compile.                                  *
  15. * BE SURE to compile with mAx dynamic memory = A000.                    *
  16. * limited to environment sizes of 255 bytes (default is 128 bytes)      *
  17. ************************************************************************}
  18.  
  19. PROGRAM MapMem;
  20.  {-look at the system memory map using DOS memory control blocks}
  21.  
  22. CONST
  23.  {set the following True to see all of the candidates for memory blocks }
  24.  {MapMem filters out some that are uninteresting or unsupported         }
  25.  showcandidates=False;
  26.  midblockid=$4D;    {byte DOS uses to identify part of MCB chain}
  27.  endblockid=$5A;    {byte DOS uses to identify last block of MCB chain}
  28.  maxvector=$40;     {highest interrupt vector checked for trapping}
  29.  
  30. TYPE
  31.  address=RECORD
  32.           offset,segment:Integer;
  33.          END;
  34. VAR
  35.  dosv:Byte;         {the major DOS version number}
  36.  mcbseg:Integer;    {potential segment address of an MCB}
  37.  nextseg:Integer;   {computed segment address for the next MCB}
  38.  prevseg:Integer;   {segment address of the previous PSP}
  39.  oldseg:Integer;    {segment address of the previous-1 PSP}
  40.  pspadd:Integer;    {segment address of the current PSP}
  41.  mcblen:Integer;    {size of the current memory block in paragraphs}
  42.  gotfirst:Boolean;  {true after first MCB is found}
  43.  gotlast:Boolean;   {true after last MCB is found}
  44.  idbyte:Byte;       {byte that DOS uses to identify an MCB}
  45.  vectors:ARRAY[0..maxvector] OF address ABSOLUTE 0:0;
  46.  
  47.  FUNCTION DOSversion:Byte;
  48.   {-return the major version number of DOS}
  49.  VAR
  50.   reg:RECORD
  51.        CASE Byte OF
  52.         1:(ax,bx,cx,dx,bp,si,di,ds,es,flags:Integer);
  53.         2:(al,ah,bl,bh,cl,ch,dl,dh:Byte);
  54.       END;
  55.  BEGIN
  56.   reg.ah:=$30;
  57.   MsDos(reg);
  58.   DOSversion:=reg.al;
  59.  END{dosversion};
  60.  
  61.  PROCEDURE ShowTheBlock(VAR mcbseg,prevseg,nextseg:Integer;
  62.                         VAR gotfirst,gotlast:Boolean);
  63.   {-display information regarding the memory block}
  64.  TYPE
  65.   pathname=STRING[64];
  66.   hexstring=STRING[4];
  67.  VAR
  68.   st:pathname;
  69.  
  70.   FUNCTION Hex(i:Integer):hexstring;
  71.    {-return hex representation of integer}
  72.   CONST
  73.    hc:ARRAY[0..15] OF Char='0123456789ABCDEF';
  74.   VAR
  75.    l,h:Byte;
  76.   BEGIN
  77.    l:=Lo(i);h:=Hi(i);
  78.    Hex:=hc[h SHR 4]+hc[h AND $F]+hc[l SHR 4]+hc[l AND $F];
  79.   END{hex};
  80.  
  81.   FUNCTION Cardinal(i:Integer):Real;
  82.    {-return an unsigned integer 0..65535}
  83.   VAR
  84.    r:Real;
  85.   BEGIN
  86.    r:=i;
  87.    IF r<0 THEN r:=r+65536.0;
  88.    Cardinal:=r;
  89.   END{cardinal};
  90.  
  91.   FUNCTION Owner(startadd:Integer):pathname;
  92.    {-return the name of the owner program of an MCB}
  93.   VAR
  94.    e:STRING[255];
  95.    i:Integer;
  96.    t:pathname;
  97.  
  98.    PROCEDURE StripPathname(VAR pname:pathname);
  99.     {-remove leading drive or path name from the input}
  100.    VAR
  101.     spos,cpos,rpos:Byte;
  102.    BEGIN
  103.     spos:=Pos('\',pname);
  104.     cpos:=Pos(':',pname);
  105.     IF spos+cpos=0 THEN Exit;
  106.     IF spos<>0 THEN BEGIN
  107.      {find the last slash in the pathname}
  108.      rpos:=Length(pname);
  109.      WHILE (rpos>0) AND (pname[rpos]<>'\') DO rpos:=Pred(rpos);
  110.     END ELSE
  111.      rpos:=cpos;
  112.     Delete(pname,1,rpos);
  113.    END{strippathname};
  114.  
  115.   BEGIN
  116.    {get the environment string to scan}
  117.    e[0]:=#255;
  118.    Move(Mem[startadd:0],e[1],255);
  119.  
  120.    {find end of the standard environment}
  121.    i:=Pos(#0#0,e);
  122.    IF i=0 THEN BEGIN
  123.     {something's wrong, exit gracefully}
  124.     Owner:='';
  125.     Exit;
  126.    END;
  127.  
  128.    {end of environment found, get the program name that follows it}
  129.    t:='';
  130.    i:=i+3;          {skip over #0#0#args}
  131.    REPEAT
  132.     t:=t+Chr(Mem[startadd:i]);
  133.     i:=Succ(i);
  134.    UNTIL Mem[startadd:i]=0;
  135.    StripPathname(t);
  136.    Owner:=t;
  137.  
  138.   END;              {owner}
  139.  
  140.   PROCEDURE WriteHooks(start,stop:Integer);
  141.    {-show the trapped interrupt vectors}
  142.   VAR
  143.    v:Byte;
  144.    vadd,sadd,eadd:Real;
  145.  
  146.    FUNCTION RealAdd(a:address):Real;
  147.     {-return the real equivalent of an address (pointer)}
  148.    BEGIN
  149.     WITH a DO
  150.      RealAdd:=16.0*Cardinal(segment)+Cardinal(offset);
  151.    END{realadd};
  152.  
  153.   BEGIN
  154.    sadd:=16.0*Cardinal(start);
  155.    eadd:=16.0*Cardinal(stop);
  156.    FOR v:=0 TO maxvector DO BEGIN
  157.     vadd:=RealAdd(vectors[v]);
  158.     IF (vadd>=sadd) AND (vadd<=eadd) THEN
  159.      Write(Copy(Hex(v),3,2),' ');
  160.    END;
  161.   END{writehooks};
  162.  
  163.   PROCEDURE writemost;
  164.    {-write most of the information about the memory block}
  165.   BEGIN
  166.    {.F-}
  167.       Write(' ',
  168.             Hex(mcbseg), '    ',              {MCB address}
  169.             Hex(pspadd), '    ',              {PSP address}
  170.             Hex(mcblen), '   ',               {size of block in paragraphs}
  171.             16.0*Cardinal(mcblen):6:0, '  '); {size of block in bytes}
  172.    {.F+}
  173.  
  174.    {get the program owning this block by scanning the environment}
  175.    IF gotfirst THEN
  176.     IF dosv>=3 THEN
  177.      st:=Owner(MemW[pspadd:$2C])
  178.     ELSE
  179.      st:='N/A'
  180.    ELSE
  181.     st:='(DOS)';
  182.    WHILE Length(st)<13 DO st:=st+' ';
  183.    Write(st);
  184.  
  185.   END{writemost};
  186.  
  187.   PROCEDURE QueueSegs(pspadd:Integer;VAR prevseg,oldseg:Integer);
  188.    {-push the PSP segments back through a 2 deep queue}
  189.   BEGIN
  190.    oldseg:=prevseg;
  191.    prevseg:=pspadd;
  192.   END{queuesegs};
  193.  
  194.  BEGIN              {showtheblock}
  195.  
  196.   mcblen:=MemW[mcbseg:3];{size of the MCB in paragraphs}
  197.   nextseg:=Succ(mcbseg+mcblen);{where the next MCB should be}
  198.   pspadd:=MemW[mcbseg:1];{address of program segment prefix for MCB}
  199.  
  200.   IF showcandidates THEN BEGIN
  201.    {show all potential MCBs without filtering techniques we employ below}
  202.    LowVideo;
  203.    writemost;
  204.    Write('  ',Hex(nextseg),'  ',Hex(Mem[nextseg:0]),'  ');
  205.    WriteLn;
  206.    highvideo;
  207.   END;
  208.  
  209.   IF (gotlast OR (Mem[nextseg:0]=$4D)) AND (pspadd<>0) THEN BEGIN
  210.    {found part of MCB chain}
  211.  
  212.    IF gotlast OR (pspadd=prevseg) OR (pspadd=oldseg) THEN BEGIN
  213.     {this is the MCB for the program, not for its environment}
  214.     writemost;
  215.     {show any interrupt vectors trapped by the program}
  216.     IF gotfirst THEN WriteHooks(pspadd,nextseg);
  217.     WriteLn;
  218.     gotfirst:=True;
  219.    END;
  220.  
  221.    QueueSegs(pspadd,prevseg,oldseg);
  222.  
  223.   END;
  224.  END{showtheblock};
  225.  
  226. BEGIN               {main}
  227.  
  228.  WriteLn;
  229.  WriteLn('                         Allocated Memory Map');
  230.  WriteLn;
  231.  WriteLn('MCB adr PSP adr  paras   bytes   owner        hooked vectors');
  232.  WriteLn('------- ------- ------- ------- ----------   ------------------------------');
  233.  
  234.  {start above the Basic work area, could probably start even higher}
  235.  {there must be a magic address to start from, but it is not documented}
  236.  mcbseg:=$50;
  237.  prevseg:=0;
  238.  oldseg:=0;
  239.  gotfirst:=False;
  240.  gotlast:=False;
  241.  dosv:=DOSversion;
  242.  
  243.  {scan all memory until the last block is found}
  244.  WHILE mcbseg<>$A000 DO BEGIN
  245.   idbyte:=Mem[mcbseg:0];
  246.   IF idbyte=midblockid THEN BEGIN
  247.    {an allocated block}
  248.    ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
  249.    {search every paragraph boundary until first block is found}
  250.    {then chain directly from block to block}
  251.    IF gotfirst THEN mcbseg:=nextseg ELSE mcbseg:=Succ(mcbseg);
  252.   END ELSE IF (idbyte=endblockid) AND gotfirst THEN BEGIN
  253.    {last block, exit}
  254.    gotlast:=True;
  255.    ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
  256.    mcbseg:=$A000;
  257.   END ELSE
  258.    {still looking for first block, try every paragraph boundary}
  259.    mcbseg:=Succ(mcbseg);
  260.  END;
  261.  
  262. END.
  263.  
  264.